home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1991 September & October / rerun-1991-09-10.d64 / moon phases (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  13KB  |  384 lines
  1. 4 printchr$(142);chr$(8)"[147]":p$="menu runner":poke53264,0
  2. 8 printtab(9)"[154]please wait while data":printtab(12)"is being loaded"
  3. 12 poke53281,0:v=53248:pokev,190:pokev+1,106:pokev+2,190:pokev+3,148
  4. 16 pokev+4,234:pokev+5,106:pokev+6,234:pokev+7,148:pokev+29,15:pokev+23,15
  5. 20 poke53280,12:nm=332.195833:dn=int(nm):ky=1989
  6. 24 sd=54272:for i=sd to sd+23:poke i,0:next:poke sd+24,15:poke 788,52
  7. 28 forp1=15360 to 15422:readq1:pokep1,q1:next
  8. 32 forp2=15424 to 15486:readq2:pokep2,q2:next
  9. 36 forp3=15488 to 15550:readq3:pokep3,q3:next
  10. 40 forp4=15552 to 15614:readq4:pokep4,q4:next
  11. 44 forp5=15616 to 15678:readq5:pokep5,q5:next
  12. 48 forp6=15680 to 15742:readq6:pokep6,q6:next
  13. 52 forp7=15744 to 15806:readq7:pokep7,q7:next
  14. 56 forp8=15808 to 15870:readq8:pokep8,q8:next
  15. 60 forp9=15872 to 15934:readq9:pokep9,q9:next
  16. 64 forp10=15936 to 15998:readq10:pokep10,q10:next
  17. 68 forp11=16000 to 16062:readq11:pokep11,q11:next
  18. 72 forp12=16064 to 16126:readq12:pokep12,q12:next
  19. 76 forp13=16128 to 16190:readq13:pokep13,q13:next
  20. 80 forp14=16192 to 16254:readq14:pokep14,q14:next
  21. 84 forp15=16256 to 16318:readq15:pokep15,q15:next
  22. 88 forp16=16320 to 16382:readq16:pokep16,q16:next:goto176
  23. 92 poke v+21,0:print"[147]"
  24. 96 printtab(14)"[159]loading me[158]n[159]u":print"[144]load"chr$(34)p$chr$(34)",8"
  25. 100 poke198,4:poke631,13:poke632,82:poke633,213:poke634,13:end
  26. 104 print"[147]":pokev+21,0:poke53281,14:poke53280,14:sys64738
  27. 108 for w=1 to 1000:next w
  28. 112 poke 198,0
  29. 116 for c=1 to 10
  30. 120 get c$:if c$="[136]"then92
  31. 124 if c$="[140]"then104
  32. 128 if c$<>"[136]" and c$<>"[140]" and c$<>""then176
  33. 132 next
  34. 136 print" [146]press any key[145]"
  35. 140 for d=1 to 30
  36. 144 get d$:if d$="[136]"then92
  37. 148 if d$="[140]"then104
  38. 152 if d$<>"[136]" and d$<>"[140]" and d$<>""then176
  39. 156 next
  40. 160 print" [152]press[146] any[146] key[145]"
  41. 164 goto116
  42. 168 print"[145]                   [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";:return
  43. 172 printtab(8+len(s$))"[145] [157]":s$="":return
  44. 176 gosub936:poke198,0
  45. 180 pokev+21,0:md=0:l=0:y$="0":m$="0":d$="0":ah$="0":print"[147]"
  46. 184 print" year ? [156]";:y$=""
  47. 185 if xx>10 then xx=0
  48. 186 if xx>5 then print" [157]";:goto 190
  49. 188 print"[164][157]";
  50. 190 get a$
  51. 192 if a$="[136]"then92
  52. 196 if a$="[140]"then104
  53. 200 if a$=chr$(19) then176
  54. 204 if a$=chr$(20) then print:gosub936:gosub168:goto184
  55. 208 if a$=chr$(13) then print:s$=y$:gosub172:goto224
  56. 212 if a$<"0" or a$>"9" then222
  57. 216 if len(y$)>3 then222
  58. 220 print a$;:y$=y$+a$
  59. 222 xx=xx+1:goto 185
  60. 224 yy=val(y$)
  61. 228 if yy>2500 or yy<1582 then gosub168:goto184
  62. 232 gosub936
  63. 236 print" month? [156]";:m$=""
  64. 237 if xx>10 then xx=0
  65. 238 if xx>5 then print" [157]";:goto 242
  66. 240 print"[164][157]";
  67. 242 get a$
  68. 244 if a$=chr$(19) then176
  69. 248 if a$=chr$(20) then print:gosub936:gosub168:goto236
  70. 252 if a$=chr$(13) then print:s$=m$:gosub172:goto268
  71. 256 if a$<"0" or a$>"9" then266
  72. 260 if len(m$)>1 then266
  73. 264 print a$;:m$=m$+a$
  74. 266 xx=xx+1:goto 237
  75. 268 mm=val(m$)
  76. 272 ifmm<1ormm>12 then gosub168:goto236
  77. 276 if yy=1582 and mm<10 then gosub168:goto236
  78. 280 gosub936
  79. 284 print" day  ?[156] ";:d$=""
  80. 285 if xx>10 then xx=0
  81. 286 if xx>5 then print" [157]";:goto 290
  82. 288 print"[164][157]";
  83. 290 get a$
  84. 292 if a$=chr$(19) then176
  85. 296 if a$=chr$(20) then print:gosub936:gosub168:goto284
  86. 300 if a$=chr$(13) then print:s$=d$:gosub172:dd=val(d$):goto324
  87. 304 if a$<"0" or a$>"9" then314
  88. 308 if len(d$)>1 then314
  89. 312 print a$;:d$=d$+a$
  90. 314 xx=xx+1:goto 285
  91. 316 if mm=2 and dd>29 then gosub168:goto284
  92. 320 goto332
  93. 324 if((yy/4=int(yy/4))and(yy/100<>int(yy/100)))or(yy/400=int(yy/400))then316
  94. 328 if mm=2 and dd>28 then gosub168:goto284
  95. 332 if(mm=4 or mm=6 or mm=9 or mm=11)and dd>30 then gosub168:goto284
  96. 336 if dd<1 or dd>31 then gosub168:goto284
  97. 340 dd=dd-1
  98. 344 if yy=1582andmm=10anddd<14thengosub168:goto284
  99. 348 gosub936
  100. 352 print" hour ?[156] ";:ah$="":ap$=""
  101. 353 if xx>8 then xx=0
  102. 354 if xx>4 then print" [157]";:goto 358
  103. 356 print"[164][157]";
  104. 358 get a$
  105. 360 a=val(a$)
  106. 364 if a$=chr$(19) then176
  107. 368 if a$=chr$(20) then print:gosub936:gosub168:goto352
  108. 372 if a$=chr$(13) then print:s$=ah$:gosub172:goto400
  109. 376 if a$="a" or a$="p" or a$="m" then384
  110. 380 if a$<"0" or a$>"9" then398
  111. 384 if len(ah$)>3 then398
  112. 388 print a$;
  113. 392 if a$<>right$(str$(a),len(a$)) then ap$=ap$+a$
  114. 396 ah$=ah$+a$
  115. 398 xx=xx+1:goto 353
  116. 400 ah=val(ah$)
  117. 404 if ah<1 or ah>12 thengosub168:goto352
  118. 408 aq$=right$(ah$,2)
  119. 412 if aq$<>ap$ then gosub168:goto352
  120. 416 if aq$<>"am" and aq$<>"pm" then gosub168:goto352
  121. 420 if ap$="am" and ah=12 then ah=0
  122. 424 if ap$="pm" and ah<12 then ah=ah+12
  123. 428 ah=ah/24
  124. 432 gosub936
  125. 436 print"[145][145][145][145]"tab(20)" moon phase: [146]":printtab(22)"working...[158]"
  126. 440 y=yy-ky:n=sgn(y):yd=y*365
  127. 448 for mn=1 to mm-1
  128. 452 dc=31
  129. 456 if mm=1 then dc=0
  130. 460 if mn=2 then dc=28
  131. 464 if mn=4 or mn=6 or mn=9 or mn=11 then dc=30
  132. 468 md=md+dc
  133. 472 next mn
  134. 476 gosub700
  135. 480 if n=0 then n=1
  136. 484 yt=abs(n*(yd+md+dd+ah-nm)+l)
  137. 488 ya=abs(n*(yd+md+dd+ah-dn)+l)
  138. 492 if yd+md+dd+ah<=nm then512
  139. 500 lm=(yt/29.53058):pf=lm-int(lm):lp=pf*29.53058
  140. 504 wn=ya/7:df=wn-int(wn):dw=(df*7)+1.01
  141. 508 goto520
  142. 512 lm=(yt/29.53058):pf=lm-int(lm):lp=29.53058-(pf*29.53058)
  143. 516 wn=ya/7:df=wn-int(wn):dw=7-(df*7)+1.01
  144. 520 b=abs(lp)*1000+.5:mp=sgn(lp)*int(b)/1000
  145. 524 if yy=ky and md+dd=dn then dw=1.01
  146. 528 if dw>8 then dw=1.01
  147. 532 if dw>5 and dw<6 then dw$=" sunday"
  148. 536 if dw>6 and dw<7 then dw$=" monday"
  149. 540 if dw>7 and dw<8 then dw$=" tuesday"
  150. 544 if dw>1 and dw<2 then dw$="wednesday"
  151. 548 if dw>2 and dw<3 then dw$="thursday"
  152. 552 if dw>3 and dw<4 then dw$=" friday"
  153. 556 if dw>4 and dw<5 then dw$="saturday"
  154. 560 gosub944
  155. 564 if mp>=1.845 and mp<=5.535 then n3=248:n4=249:n5=12:n8=6:n9=6:goto572
  156. 568 goto576
  157. 572 print""tab(20)"first crescent":gosub720
  158. 576 if mp>=5.536 and mp<=9.225 then n3=241:n4=243:n5=12:n8=14:n9=14:goto584
  159. 580 goto588
  160. 584 print""tab(20)"first quarter":gosub720
  161. 588 if mp>=9.226 and mp<=12.915 then goto596
  162. 592 goto604
  163. 596 n1=253:n2=252:n3=241:n4=243:n5=15:n6=3:n7=3:n8=3:n9=3
  164. 600 print""tab(20)"waxing gibbous":gosub720
  165. 604 if mp>=12.916 and mp<=16.605 then goto612
  166. 608 goto620
  167. 612 n1=240:n2=242:n3=241:n4=243:n5=15:n6=1:n7=1:n8=1:n9=1
  168. 616 print""tab(22)"full moon ":gosub720
  169. 620 if mp>=16.606 and mp<=20.295 then goto628
  170. 624 goto636
  171. 628 n1=240:n2=242:n3=254:n4=255:n5=15:n6=3:n7=3:n8=3:n9=3
  172. 632 print""tab(20)"waning gibbous":gosub720
  173. 636 if mp>=20.296 and mp<=23.985 then n1=240:n2=242:n5=3:n6=14:n7=14:goto644
  174. 640 goto648
  175. 644 print""tab(20)"last quarter":gosub720
  176. 648 if mp>=23.986 and mp<=27.675 then n1=250:n2=251:n5=3:n6=6:n7=6:goto656
  177. 652 goto660
  178. 656 print""tab(20)"last crescent":gosub720
  179. 660 if(mp>=27.676 and mp<=29.53)or(mp>=0and mp<=1.844)then goto668
  180. 664 goto676
  181. 668 n1=244:n2=246:n3=245:n4=247:n5=15:n6=1:n7=1:n8=1:n9=1
  182. 672 print""tab(22)"new moon  ":gosub720
  183. 676 goto108
  184. 680 if n=1 then692
  185. 684 if mm>2 and mm<13 then l=l-1
  186. 688 goto696
  187. 692 if mm=1 or mm=2 then l=l-1
  188. 696 return
  189. 700 for x=yy to ky step1*sgn(ky-yy)
  190. 704 if((x/4=int(x/4))and(x/100<>int(x/100)))or(x/400=int(x/400))then l=l+1
  191. 708 next
  192. 712 if((yy/4=int(yy/4))and(yy/100<>int(yy/100)))or(yy/400=int(yy/400))then680
  193. 716 goto696
  194. 720 printtab(22)"[154]"dw$
  195. 724 poke2040,n1:poke2041,n2:poke2042,n3:poke2043,n4:pokev+21,n5:pokev+39,n6
  196. 728 pokev+40,n7:pokev+41,n8:pokev+42,n9
  197. 732 print"":printtab(16)
  198. 736 on mm goto740,768,796,796,800,840,856,856,860,861,896,924
  199. 740 if mm=1 and dd=0 then print"    new year's [154]day";
  200. 741 if yy>1985 and mm=1 and(dd>13anddd<21)and dw$=" monday"then743
  201. 742 goto746
  202. 743 print"   m. l. king jr.'s":printtab(23)"birthday"
  203. 744 printtab(23)"observed[145][145][145]":goto768
  204. 746 ifyy>1985andmm=1anddd=14thenprint"   [154]m. l. king jr.'s":goto752
  205. 748 goto768
  206. 752 printtab(23)"birthday[145][145]"
  207. 768 if mm=2 and dd=1 then print"    [154]groundhog day";
  208. 772 if yy>1865 and mm=2 and dd=11 then print"  [156]lincoln's birthday";
  209. 776 if mm=2 and dd=13 then print"   valentine's day";
  210. 780 if yy>1970 and mm=2 and (dd>13 and dd<21) and dw$=" monday" then786
  211. 784 goto792
  212. 786 if yy>1990 then print"   presidents' day";:goto 792
  213. 788 print" washington's birthday":printtab(23)"observed[145]";
  214. 792 if yy>1799 and mm=2 and dd=21 t